home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / htmlHomePageUtils.tcl < prev    next >
Text File  |  1999-04-24  |  62KB  |  1,697 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlHomePageUtils.tcl"
  6.  #                                    created: 97-06-26 12.51.42 
  7.  #                                last update: 99-04-24 13.17.59 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4
  13.  # 
  14.  # Copyright 1996-1999 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. #===============================================================================
  25. # Checking links
  26. #===============================================================================
  27.  
  28. # Check that links are valid.
  29. proc htmlCheckWindow {} {htmlCheckLinks Window}
  30. proc htmlCheckHomePage {} {htmlCheckLinks Home}
  31. proc htmlCheckFolder {} {htmlCheckLinks Folder}
  32. proc htmlCheckFile {} {htmlCheckLinks File}
  33.  
  34. proc htmlIsThereAHomePage {} {
  35.     global HTMLmodeVars    
  36.     if {![llength $HTMLmodeVars(homePages)]} {
  37.         alertnote "You must set a home page folder."
  38.         htmlHomePages
  39.     }
  40.     return [llength $HTMLmodeVars(homePages)]
  41. }
  42.  
  43. proc htmlWhichHomePage {msg} {
  44.     global HTMLmodeVars
  45.     foreach hp $HTMLmodeVars(homePages) {
  46.         lappend hplist "[lindex $hp 1][lindex $hp 2]"
  47.     }
  48.     if {[catch {listpick -p "Select home page to $msg." $hplist} hp] || ![string length $hp]} {error ""}
  49.     set home [lindex $HTMLmodeVars(homePages) [lsearch -exact $hplist $hp]]
  50.     if {![file exists [lindex $home 0]] || ![file isdirectory [lindex $home 0]]} {
  51.         alertnote "Can't find the folder for [lindex $home 1][lindex $home 2]"
  52.         error ""
  53.     }
  54.     return $home
  55. }
  56.  
  57. # Checks if a folder contains a home page folder or an include folder as a subfolder.
  58. proc htmlContainHpFolder {folder} {
  59.     global HTMLmodeVars
  60.     foreach p $HTMLmodeVars(homePages) {
  61.         foreach i {0 4} {
  62.             if {[llength $p] == $i} {continue}
  63.             if {[string match "$folder:*" "[lindex $p $i]:"] && "[lindex $p $i]:" != "$folder:"} {
  64.                 return 1
  65.             }
  66.         }
  67.     }
  68.     return 0
  69. }
  70.  
  71.  
  72. proc htmlCheckLinks {where {checking 1}} {
  73.     global HTMLmodeVars
  74.         
  75.     # Save all open window?
  76.     if {$where != "Window" && 
  77.     [htmlAllSaved "-c {Save all open windows before checking links?}"] == "cancel"} { return}
  78.     set filebase 0
  79.     if {$where == "File"} {
  80.         if {[catch {getfile "Select file to scan."} files]} {return}
  81.         # Is this a text file?
  82.         if {![htmlIsTextFile $files alertnote]} {return}
  83.         set base [htmlBASEfromPath $files]
  84.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$files"; return}
  85.         set path [lindex $base 1]
  86.         set homepage [lindex $base 3]
  87.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  88.         set base [lindex $base 0]
  89.         if {$base == "file:///"} {set filebase [string length "[file dirname $files]:"]}
  90.         set filelist [htmlOpenAfile]
  91.         puts [lindex $filelist 0] $files
  92.         close [lindex $filelist 0]
  93.         set files [lindex $filelist 1]
  94.     } elseif {$where == "Window"} {
  95.         set files [stripNameCount [lindex [winNames -f] 0]]
  96.         if {![file exists $files]} {
  97.             if {[lindex [dialog -w 200 -h 70 -t "You must save the window." 10 10 390 30  \
  98.             -b Save 20 40  85 60 \
  99.             -b Cancel 110 40 175 60] 1]} {
  100.                 error ""
  101.             }
  102.             if {![catch {saveAs "Untitled.html"}]} {
  103.                 set files [stripNameCount [lindex [winNames -f] 0]]
  104.             } else {
  105.                 error "" 
  106.             }
  107.         } else {
  108.             if {[winDirty] && [askyesno "Save window?"] == "yes"} {save}
  109.         }
  110.         set base [htmlBASEfromPath $files]
  111.         if {$checking != 2 && $HTMLmodeVars(useBigBrother)} {htmlBigBrother "$files"; return}
  112.         set path [lindex $base 1]
  113.         set homepage [lindex $base 3]
  114.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  115.         set base [lindex $base 0]
  116.         if {$base == "file:///"} {set filebase [string length "[file dirname $files]:"]}
  117.         set filelist [htmlOpenAfile]
  118.         puts [lindex $filelist 0] $files
  119.         close [lindex $filelist 0]
  120.         set files [lindex $filelist 1]
  121.     } elseif {$where == "Folder"} {
  122.         if {[catch {htmlGetDir "Folder to scan."} folder]} {return}
  123.         set base [htmlBASEfromPath $folder]
  124.         set subFolders [expr ![string compare yes [askyesno "Check files in subfolders?"]]]
  125.         if {$subFolders && ![set subFolders [expr ![htmlContainHpFolder $folder]]] &&
  126.         [lindex [dialog -w 410 -h 135 -t "The folder '[file tail $folder]' contains a\
  127.         home page folder or an include folder, but is itself not inside one. You can't\
  128.         simultaneously check links both inside and outside home page or include folders.\
  129.         Sorry!\rBut\
  130.         you can still check this folder and skip the subfolders." 10 10 400 90\
  131.         -b Check 20 105 85 125 -b Cancel 110 105 175 125] 1]} {return}
  132.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$folder:" $subFolders; return}
  133.         set path [lindex $base 1]
  134.         set homepage [lindex $base 3]
  135.         set isinfld [lindex $base [expr 3 + [lindex $base 4] / 2]]
  136.         set base [lindex $base 0]
  137.         if {$base == "file:///"} {set filebase [string length "$folder:"]}
  138.         if {$subFolders} {
  139.             set files [htmlAllHTMLfiles $folder 1]
  140.         } else {
  141.             set files [htmlGetHTMLfiles $folder 1]
  142.         }
  143.     } else {
  144.         # Check that a home page is defined.
  145.         if {![htmlIsThereAHomePage]} {return}
  146.         if {[catch {htmlWhichHomePage "check links in"} hp]} {return}
  147.         set homepage [lindex $hp 0]
  148.         set isinfld $homepage
  149.         if {$HTMLmodeVars(useBigBrother)} {htmlBigBrother "$homepage:" 1; return}
  150.         set files [htmlAllHTMLfiles $homepage 1]
  151.         set base [lindex $hp 1]
  152.         set path [lindex $hp 2]
  153.     }
  154.     return [htmlScanFiles $files $base $path $homepage $isinfld $checking $filebase]
  155. }
  156.  
  157. # Select a new file for an invalid link.
  158. proc htmlLinkToNewFile {} {
  159.     if {![string match "*Invalid URLs*" [set win [lindex [winNames] 0]]] || [lindex [posToRowCol [getPos]] 0] < 3} {return}
  160.     set str [getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]
  161.     gotoMatch
  162.     regexp {Line [0-9]+:([^∞]+)} $str dum url
  163.     regsub -all {\((BASE|Invalid|anchor|case)[^\)]+\)} $url "" url
  164.     set url [string trim $url]
  165.     set str ""
  166.     regexp {[^#]*} $url str
  167.     set anchor [string trim [string range $url [string length $str] end] \"]
  168.     regsub -all {[\(\)]} $url {\\\0} url
  169.     if {[catch {search -s -f 1 -i 0 -r 1 -m 0 -l [selEnd] $url [getPos]} res]} {
  170.         alertnote "Can't find link to change on selected line."
  171.         return
  172.     }
  173.     if {[set newFile [htmlGetFile 0]] == ""} {return}
  174.     set newLink [lindex $newFile 0]
  175.     set wh [lindex $newFile 1]
  176.     if {$wh == "" && $anchor != "" && [htmlCheckAnchor $pathToNewFile $url]} {
  177.         append newLink $anchor
  178.     }
  179.     set f [htmlURLescape2 $newLink]
  180.     if {![regsub {([^=]+=)(\"[^\"]+\"|[^ ]+)} $url "\\1\"$f\"" url]} {set url url(\"$f\")}
  181.     replaceText [set start [lindex $res 0]] [lindex $res 1] $url
  182.     # If it's an IMG tag, replace WIDTH and HEIGHT.
  183.     if {$wh != "" && [string toupper [string range $url 0 2]] == "SRC" &&
  184.     ![catch {search -s -f 0 -i 1 -r 1 -m 0 {<IMG[ \t\r\n]+[^<>]+>} $start} res1] &&
  185.     [lindex $res1 1] > [lindex $res 1]} {
  186.         if {![catch {search -s -f 1 -i 1 -r 1 -m 0 -l [expr [lindex $res1 1] + 1] {WIDTH=\"?[0-9]*\"?} [lindex $res1 0]} res2]} {
  187.             replaceText [lindex $res2 0] [lindex $res2 1] [htmlSetCase WIDTH=\"[lindex $wh 0]\"]
  188.         }
  189.         if {![catch {search -s -f 1 -i 1 -r 1 -m 0 -l [expr [lindex $res1 1] + 1] {HEIGHT=\"?[0-9]*\"?} [lindex $res1 0]} res2]} {
  190.             replaceText [lindex $res2 0] [lindex $res2 1] [htmlSetCase HEIGHT=\"[lindex $wh 1]\"]
  191.         }
  192.     }
  193.     # Remove line with corrected link.
  194.     bringToFront $win
  195.     setWinInfo read-only 0
  196.     deleteText [lineStart [getPos]] [nextLineStart [getPos]]
  197.     select [lineStart [getPos]] [nextLineStart [getPos]]
  198.     setWinInfo dirty 0
  199.     setWinInfo read-only 1
  200. }
  201.  
  202. bind '\r' <o> htmlLinkToNewFile Brws
  203. bind enter <o> htmlLinkToNewFile Brws
  204.  
  205. proc htmlBbthReadSettings {} {
  206.     set allSettings [AEBuild -r 'Bbth' core getd ---- "obj{want:type('reco'),from:null(),form:'prop',seld:type('allS')}"]
  207.     set allSettings [string range $allSettings 17 [expr [string length $allSettings] - 2]]
  208.     return $allSettings
  209. }
  210.  
  211. proc htmlBbthRestoreSettings {settings} {
  212.     AEBuild 'Bbth' core setd "----" "obj{want:type('reco'),from:null(),form:'prop',seld:type('allS')}" "data" $settings
  213. }
  214.  
  215. proc htmlBigBrother {path {searchSubFolder 0}} {
  216.     global HTMLmodeVars
  217.     # define url mapping
  218.     set urlmap [htmlURLmap]
  219.     # launches Big Brother
  220.     if {![app::isRunning Bbth] && [catch {app::launchBack Bbth}]} {
  221.         alertnote "Could not find or launch Big Brother."
  222.         return
  223.     }
  224.     if {[set vers [htmlGetVersion Bbth]] >= 1.1} {
  225.         # Read all settings.
  226.         set allSettings [htmlBbthReadSettings]
  227.         # Change settings
  228.         if {!$HTMLmodeVars(useBBoptions)} {
  229.             AEBuild 'Bbth' core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Loly')}" "data" "bool(«0$HTMLmodeVars(ignoreRemote)»)"
  230.             AEBuild 'Bbth' core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Roly')}" "data" "bool(«0$HTMLmodeVars(ignoreLocal)»)"
  231.         }
  232.         AEBuild 'Bbth' core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Sfld')}" "data" "bool(«0$searchSubFolder»)"
  233.         AEBuild 'Bbth' core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[$urlmap\]"
  234.         if {$vers >= 1.2} {
  235.             AEBuild 'Bbth' core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('CasS')}" "data" "bool(«0$HTMLmodeVars(caseSensitive)»)"        
  236.         }
  237.     } else {
  238.         alertnote "Cannot change the settings in Big Brother. You need Big Brother 1.1 or later."
  239.     }
  240.     # Sends a file or folder to be opened.
  241.     sendOpenEvent noReply 'Bbth' $path
  242.     # Restore settings
  243.     if {$vers >= 1.1} {htmlBbthRestoreSettings $allSettings}
  244.     if {$HTMLmodeVars(checkInFront)} {switchTo 'Bbth'}
  245. }
  246.  
  247.  
  248. #  Checking of remote links in a document
  249. proc htmlCheckRemoteLinks {} {
  250.     global htmlNumBbthChecking
  251.     if {[htmlGetVersion Bbth] < 1.2} {
  252.         alertnote "You need Big Brother 1.2 or later to check and fix remote links."
  253.         return
  254.     }
  255.     set urlList [htmlCheckLinks Window 2]
  256.     if {![llength $urlList]} {alertnote "No remote links to check."; return}
  257.     if {![app::isRunning Bbth] && [catch {app::launchBack Bbth}]} {
  258.         alertnote "Could not find or launch Big Brother."
  259.         return
  260.     }
  261.     set htmlBbthChkdWin [stripNameCount [lindex [winNames -f] 0]]
  262.     set sep ""
  263.     foreach url $urlList {
  264.         append theRecord "$sep{Url :“[lindex $url 1]”, Id# :“[concat $url $htmlBbthChkdWin]”}"
  265.         set sep ", "
  266.     }
  267.     # Read all settings.
  268.     set allSettings [htmlBbthReadSettings]
  269.     
  270.     # Don't ignore remote links
  271.     AEBuild 'Bbth' core setd "----" "obj{want:type('bool'),from:null(),form:'prop',seld:type('Loly')}" "data" "bool(«00»)"
  272.     # No url mappings.
  273.     AEBuild 'Bbth' core setd "----" "obj{want:type('mapG'),from:null(),form:'prop',seld:type('mapS')}" "data" "\[\]"
  274.     AEBuild 'Bbth' "Bbth" "Chck" "----" "\[$theRecord\]"
  275.     htmlBbthRestoreSettings $allSettings
  276.     incr htmlNumBbthChecking [llength $urlList]
  277. }
  278.  
  279. # Takes care of events sent from Big Brother.
  280. proc htmlBbthChkdHandler {arg} {
  281.     global tileLeft tileTop tileWidth errorHeight htmlNumBbthChecking
  282.     regexp {'Id# ':“([^”]+)”} $arg dum id
  283.     regexp {CRes:([^,]+)} $arg dum result
  284.     set win [lrange $id 2 end]
  285.     switch $result {
  286.         RSuc {set str "The remote document exists."; set color 3}
  287.         LSuc {set str "The local document exists."; set color 3}
  288.         SFld {
  289.             set color 5
  290.             regexp {SCod:([^,]+)} $arg dum code
  291.             switch $code {
  292.                 "204" {set str "The document exists but contains no data."}
  293.                 "400" {set str "The server (or the proxy) reports a bad request."}
  294.                 "401" {set str "The document seems to exist but a password is required to access it."}
  295.                 "403" {set str "The document still exists but the server refuses to deliver it."}
  296.                 "404" {set str "The remote document doesn't exist."}
  297.                 "500" {set str "The server reports an internal error while trying to serve our request."}
  298.                 "501" {set str "The server doesn't seem to support checking the existence of a link."}
  299.                 "502" {set str "A gateway reported an error."}
  300.                 "503" {set str "The server is currently unable to deliver this document. This situation might be temporary."}
  301.                 default {set str "The server answered with an unknown HTTP response code."}
  302.             }
  303.         }
  304.         SMvd {
  305.             set color 1
  306.             regexp {SCod:([^,]+)} $arg dum code
  307.             regexp {nURL:“([^”]+)”} $arg dum newURL
  308.             switch $code {
  309.                 "301" {set str "The document has moved permanently to $newURL."}
  310.                 "302" {set str "The document has moved temporarily to $newURL."}
  311.                 default {set str "The document has moved to $newURL."}
  312.             }
  313.             edit -c -w $win
  314.             set l [rowColToPos [lindex $id 0] 0]
  315.             if {![catch {search -s -f 1 -i 1 -m 0 -r 0 -l [nextLineStart $l] [lindex $id 1] [lineStart $l]} res]} {
  316.                 eval replaceText $res $newURL
  317.             }
  318.         }
  319.         sFld {
  320.             set color 5
  321.             regexp {sRsn:([^,]+)} $arg dum reason
  322.             switch $reason {
  323.                 bnAb {set str "Invalid base URL: it should be an absolute URL."}
  324.                 nTCP {set str "MacTCP or Open Transport TCP/IP is needed to check remote links."}
  325.                 locF {set str "Invalid local link."}
  326.                 Open {set str "Initializing the network services failed."}
  327.                 Bind {set str "Selecting a local port failed."}
  328.                 Rslv {set str "Resolving the host name failed."}
  329.                 Conn {set str "Establishing the connection failed."}
  330.                 Send {set str "Sending the request failed."}
  331.                 Recv {set str "Receiving the server's answer failed."}
  332.                 Disc {set str "Closing the connection failed."}
  333.                 Pars {set str "The server's response doesn't conform to the HTTP/1.0 protocol."}
  334.                 Empt {set str "The server closed the connection without answering."}
  335.                 IncT {set str "The server sent only part of the document."}
  336.                 SWDr {set str "The server said the document exists, but wasn't able to deliver it."}
  337.                 NTr/ {set str "This URL should end with a slash because it points to a directory."}
  338.                 default {set str "Checking the link failed for an unknown reason."}
  339.             }
  340.         }
  341.         Sntx {set str "URL syntax error."; set color 5}
  342.     }
  343.     if {[lsearch -exact [winNames -f] "* Remote URLs *"] < 0} {
  344.         new -n "* Remote URLs *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  345.         insertText "Link checking results:  (<uparrow> and <downarrow> to browse, <return> to go to line\rLinks to moved pages have been changed.\r"
  346.         htmlSetWin
  347.     }
  348.     bringToFront "* Remote URLs *"
  349.     setWinInfo read-only 0
  350.     goto [maxPos]
  351.     insertText "Line [lindex $id 0]: "
  352.     insertColorEscape [getPos] $color 
  353.     insertText "$str"
  354.     insertColorEscape [getPos] 0
  355.     insertText " [lindex $id 1]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$win\r"
  356.     incr htmlNumBbthChecking -1
  357.     if {!$htmlNumBbthChecking} {insertText "Done.\r"}
  358.     refresh
  359.     setWinInfo dirty 0
  360.     setWinInfo read-only 1
  361. }
  362.  
  363. # Returns a list of all HTML and CSS files in a folder and its subfolders.
  364. proc htmlAllHTMLfiles {folder {CSS 0} {toExclude ""}} {
  365.     message "Building file list…"
  366.     set filelist [htmlOpenAfile]
  367.     set fid [lindex $filelist 0]
  368.     set files [lindex $filelist 1]
  369.     set folders [list $folder]
  370.     while {[llength $folders]} {
  371.         set newFolders ""
  372.         foreach fl $folders { 
  373.             htmlGetHTMLfiles $fl $CSS $fid $toExclude
  374.             # Get folders in this folder.
  375.             if {![catch {glob "$fl:*:"} filelist]} {
  376.                 foreach fil $filelist {
  377.                     lappend newFolders [string trimright $fil :]
  378.                 }
  379.             }
  380.         }
  381.         set folders $newFolders
  382.     }
  383.     close $fid
  384.     return $files
  385. }
  386.  
  387. # Finds all HTML files in a folder
  388. proc htmlGetHTMLfiles {folder {CSS 0} {fid ""} {toExclude ""}} {
  389.     global filepats
  390.     set pats $filepats(HTML)
  391.     if {$CSS && [info exists filepats(CSS)]} {append pats " " $filepats(CSS)}
  392.     set files ""
  393.     set cl 0
  394.     if {$fid == ""} {
  395.         set filelist [htmlOpenAfile]
  396.         set fid [lindex $filelist 0]
  397.         set files [lindex $filelist 1]
  398.         set cl 1
  399.     }
  400.     if {![catch {glob -t TEXT $folder:*} filelist]} {
  401.         foreach fil $filelist {
  402.             foreach suffix $pats {
  403.                 if {[string match $suffix $fil] && [lsearch -exact $toExclude $fil] < 0} {
  404.                     puts $fid $fil
  405.                     break
  406.                 }
  407.             }
  408.         }
  409.     }
  410.     if {$cl} {close $fid}
  411.     return $files
  412. }
  413.  
  414. # Opens a filelist file. Returns fileid and path.
  415. proc htmlOpenAfile {} {
  416.     global PREFS
  417.     if {![file exists $PREFS:HTMLtmp]} {mkdir $PREFS:HTMLtmp}
  418.     set i 0
  419.     while {[file exists $PREFS:HTMLtmp:tempfile$i]} {incr i}
  420.     set fid [open $PREFS:HTMLtmp:tempfile$i w+]
  421.     return [list $fid "$PREFS:HTMLtmp:tempfile$i"]
  422. }
  423.  
  424.  
  425.  
  426. # checking = 1 or 2: called from htmlCheckLinks
  427. # checking = 1:
  428. # Scan a list of files for HTML links and check if they point to existing files.
  429. # checking = 2:
  430. # Scan a list of files for HTML links and return the remote ones for checking with Big Brother.
  431. # checking = 0: called from htmlMoveFiles
  432. # Build a list of links which point to the files just moved.
  433. proc htmlScanFiles {files baseURL basePath homepage isInFolder checking filebase {movedFiles ""}} {
  434.     global htmlURLAttr HTMLmodeVars
  435.     global tileLeft tileTop tileWidth errorHeight
  436.     global htmlCaseFolders htmlCaseFiles
  437.  
  438.     set htmlCaseFolders ""; set htmlCaseFiles ""
  439.     set chCase $HTMLmodeVars(caseSensitive)
  440.     set chAnchor $HTMLmodeVars(checkAnchors)
  441.     
  442.     # Build regular expressions with URL attrs.
  443.     set exp "<!--|\[ \\t\\n\\r\]+([join $htmlURLAttr |])"
  444.     
  445.     set expBase "<base\[ \\t\\n\\r\]+\[^>\]*>"
  446.     set expBase2 "(href=)\"?(\[^ \\t\\n\\r\">\]+)\"?"
  447.     set exp1 "${exp}(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  448.     set exp2 {/\*|[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  449.     set toCheck ""
  450.     if {$checking != 2} {
  451.         set result [htmlOpenAfile]
  452.         set fidr [lindex $result 0]
  453.     }
  454.     set checkFail 0
  455.     
  456.     set commStart1 "<!--"
  457.     set commEnd1 "-->"
  458.     set commStart2 {/*}
  459.     set commEnd2 {\*/}
  460.     
  461.     # Open file with filelist
  462.     set fid0 [open $files]
  463.  
  464.     while {![eof $fid0]} {
  465.         gets $fid0 f
  466.         if {$f == "" || [catch {open $f} fid]} {continue}
  467.         set base $baseURL
  468.         set path $basePath
  469.         set hpPath $homepage
  470.         if {$isInFolder == ""} {
  471.             set epath $f
  472.         } else {
  473.             set epath [string range $f [expr [string length $isInFolder] + 1] end]
  474.         }
  475.         regsub -all {:} $epath {/} epath
  476.         set baseText ""
  477.         message "Looking at [file tail $f]…"
  478.         set filecont [read $fid 16384]
  479.         set limit [expr [eof $fid] ? 0 : 300]
  480.         if {[regexp {\n} $filecont]} {
  481.             set newln "\n"
  482.         } else {
  483.             set newln "\r"
  484.         }
  485.         # Look for BASE.
  486.         if {[regexp -nocase -indices $expBase $filecont thisLine]} {
  487.             set preBase [string range $filecont 0 [lindex $thisLine 0]]
  488.             set comm 0
  489.             while {[regexp -indices {<!--} $preBase bCom]} {
  490.                 set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  491.                 set comm 1
  492.                 if {[regexp -indices -- {-->} $preBase bCom]} {
  493.                     set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  494.                     set comm 0
  495.                 } else {
  496.                     break
  497.                 }
  498.             }
  499.             if {!$comm && [regexp -nocase $expBase2 [string range $filecont [lindex $thisLine 0] [lindex $thisLine 1]] href b url]} {
  500.                 if {![catch {htmlBASEpieces $url} basestr]} {
  501.                     set base [lindex $basestr 0]
  502.                     set path [lindex $basestr 1]
  503.                     set epath [lindex $basestr 2]
  504.                     set hpPath ""
  505.                     set baseText "(BASE used) "
  506.                 } else {
  507.                     set baseText "(Invalid BASE) "
  508.                 }
  509.             }
  510.         }
  511.         for {set i1 1} {$i1 < 3} {incr i1} {
  512.             set exprr [set exp$i1]
  513.             if {$i1 == 2} {
  514.                 seek $fid 0
  515.                 set filecont [read $fid 16384]
  516.                 set limit [expr [eof $fid] ? 0 : 300] 
  517.             }
  518.             set commStart [set commStart$i1]
  519.             set commEnd [set commEnd$i1]
  520.             set linenum 1
  521.             set comment 0
  522.             while {1} {
  523.                 # Find all links in every line.
  524.                 while {$comment || ([regexp -nocase -indices $exprr $filecont href b url] &&
  525.                 [expr [string length $filecont] - [lindex $href 0]] > $limit)} {
  526.                     # Comment?
  527.                     if {$comment || [string range $filecont [lindex $href 0] [lindex $href 1]] == $commStart} {
  528.                         if {$comment} {
  529.                             set href {0 0}
  530.                             set subcont $filecont
  531.                         } else {
  532.                             set subcont [string range $filecont [expr [lindex $href 1] + 1] end]
  533.                         }
  534.                         if {[regexp -indices -- $commEnd $subcont cend] &&
  535.                         [expr [string length $subcont] - [lindex $cend 0]] > $limit} {
  536.                             incr linenum [regsub -all $newln [string range $filecont 0 [expr [lindex $href 1] + [lindex $cend 1]]] {} dummy]
  537.                             set filecont [string range $filecont [expr [lindex $href 1] + [lindex $cend 1]] end]
  538.                             set comment 0
  539.                             continue
  540.                         } else {
  541.                             set comment 1
  542.                             break
  543.                         }
  544.                     }
  545.                     incr linenum [regsub -all $newln [string range $filecont 0 [lindex $url 0]] {} dummy]
  546.                     set linkTo [htmlURLunEscape [string trim [string range $filecont [lindex $url 0] [lindex $url 1]] \"]]
  547.                     set nogood 0
  548.                     if {[catch {htmlPathToFile $base $path $epath $hpPath $linkTo} linkToPath]} {
  549.                         if {$linkToPath == ""} {
  550.                             set nogood 1
  551.                         } elseif {$checking == 2 && [string range $linkToPath 0 6] == "http://"} {
  552.                             # Checking remote links
  553.                             lappend toCheck [list $linenum $linkToPath]
  554.                         }
  555.                         set linkToPath ""
  556.                     } else {
  557.                         # Anchors always point to the file itself, unless there's a BASE. 
  558.                         if {[string index $linkTo 0] == "#" && $baseText == ""} {set linkToPath [list $f $f]}
  559.                         set casePath [lindex $linkToPath 1]
  560.                         set linkToPath [lindex $linkToPath 0]
  561.                     }
  562.                     # If this is BASE HREF, ignore it.
  563.                     if {[string length $baseText] && [regexp -nocase -indices $expBase $filecont thisLine] \
  564.                     && [regexp -nocase $expBase2 [string range $filecont [lindex $thisLine 0] [lindex $thisLine 1]]]\
  565.                     && [lindex $thisLine 0] < [lindex $url 0] && [lindex $thisLine 1] > [lindex $url 1]} {
  566.                         set linkToPath ""
  567.                     }
  568.                     if {$checking == 1} {
  569.                         set anchorCheck 1
  570.                         set caseOK 1
  571.                         set fext [file exists $linkToPath]
  572.                         if {$chAnchor && $linkToPath != "" && [regexp {#} $linkTo] && $fext} {set anchorCheck [htmlCheckAnchor $linkToPath $linkTo]}
  573.                         if {$chCase && $linkToPath != "" && $fext} {set caseOK [htmlCheckLinkCase $linkToPath $casePath]}
  574.                         # Does the file exist? Ignore it if it's outside home page folder.
  575.                         # Then it point to someone else's home page.
  576.                         if {!$anchorCheck || $nogood || !$caseOK || ( $linkToPath != "" && !$fext)} {
  577.                             set bText $baseText
  578.                             if {!$anchorCheck} {append bText "(anchor missing) "}
  579.                             if {!$caseOK} {append bText "(case doesn't match) "}
  580.                             if {$homepage == ""} {
  581.                                 set line [string range $f $filebase end]
  582.                             } else {
  583.                                 set line [string range $f [expr [string length $isInFolder] + 1] end]
  584.                             }
  585.                             set l [expr 20 - [string length [file tail $f]]]
  586.                             set ln [expr 5 - [string length $linenum]]
  587.                             set href [string trim [string range $filecont [lindex $href 0] [lindex $href 1]]]
  588.                             append line "[format "%$l\s" ""] Line $linenum:[format "%$ln\s" ""]$bText$href"\
  589.                             "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f"
  590.                             puts $fidr $line
  591.                             set checkFail 1
  592.                         }
  593.                     } elseif {!$checking && [lsearch -exact $movedFiles $linkToPath] >=0 } {
  594.                         set href [string trim [string range $filecont [lindex $href 0] [lindex $href 1]]]
  595.                         puts $fidr [list $f $linenum $base $path $epath $linkToPath $href]
  596.                     }
  597.                     set filecont [string range $filecont [lindex $url 1] end]
  598.                 }
  599.                 if {![eof $fid]} {
  600.                     incr linenum [regsub -all $newln [string range $filecont 0 [expr [string length $filecont] - 301]] {} dummy]
  601.                     set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  602.                     set limit [expr [eof $fid] ? 0 : 300] 
  603.                 } else {
  604.                     break
  605.                 }
  606.             }
  607.         }
  608.         close $fid
  609.     }
  610.     close $fid0
  611.     catch {removeFile $files}
  612.     catch {unset htmlCaseFolders htmlCaseFiles filecont}
  613.     message ""
  614.     if {$checking == 1} {
  615.         if {$checkFail} {
  616.             seek $fidr 0
  617.             new -n "* Invalid URLs *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  618.             insertText "Incorrect links:  (<uparrow> and <downarrow> to browse, <return> to go to file,\ropt-<return> to select a new file)\r[read $fidr]"
  619.             htmlSetWin
  620.         } else {
  621.             alertnote "All links are OK."
  622.         }
  623.         close $fidr
  624.         catch {removeFile [lindex $result 1]}
  625.     } elseif {!$checking} {
  626.         return $result
  627.     } else {
  628.         return $toCheck
  629.     }
  630. }
  631.  
  632. proc htmlCheckAnchor {anchorFile url} {
  633.     regexp {[^#]*#(.*)} $url dum anchor
  634.     if {[catch {open $anchorFile r} fid]} {return 1}
  635.     set exp "<!--|<(\[Aa\]|\[mM\]\[aA\]\[pP\])\[ \t\r\n\]+\[^>\]*\[nN\]\[aA\]\[mM\]\[eE\]=\"?$anchor\"?(>|\[ \t\r\n\]+\[^>\]*>)"
  636.     set filecont [read $fid 16384]
  637.     set limit [expr [eof $fid] ? 0 : 300]
  638.     set comment 0
  639.     while {1} {
  640.         while {$comment || ([regexp -indices $exp $filecont anch] &&
  641.         [expr [string length $filecont] - [lindex $anch 0]] > $limit)} {
  642.             if {$comment || [string range $filecont [lindex $anch 0] [lindex $anch 1]] == "<!--"} {
  643.                 if {$comment} {
  644.                     set anch {0 0}
  645.                     set subcont $filecont
  646.                 } else {
  647.                     set subcont [string range $filecont [expr [lindex $anch 1] + 1] end]
  648.                 }
  649.                 if {[regexp -indices -- "-->" $subcont cend] &&
  650.                 [expr [string length $subcont] - [lindex $cend 0]] > $limit} {
  651.                     set filecont [string range $filecont [expr [lindex $anch 1] + [lindex $cend 1]] end]
  652.                     set comment 0
  653.                     continue
  654.                 } else {
  655.                     set comment 1
  656.                     break
  657.                 }
  658.             } else {
  659.                 close $fid
  660.                 return 1
  661.             }
  662.         } 
  663.         if {![eof $fid]} {
  664.             set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  665.             set limit [expr [eof $fid] ? 0 : 300] 
  666.         } else {
  667.             break
  668.         }
  669.     }
  670.     close $fid
  671.     return 0
  672. }
  673.  
  674. # Checks that the case in a link match the case in the path to file.
  675. proc htmlCheckLinkCase {path link} {
  676.     global htmlCaseFolders htmlCaseFiles
  677.     
  678.     set path [string trimright $path :]
  679.     set link [string trimright $link :]
  680.     if {[lsearch -exact $htmlCaseFiles $path] >= 0} {return 1}
  681.     set path [split $path :]
  682.     set plen [llength $path]
  683.     set llen [llength [split $link :]]
  684.     set j [expr $plen - $llen ? $plen - $llen - 1 : 0]
  685.     for {set i $j} {$i < $plen - 1} {incr i} {
  686.         set l [lindex $path [expr $i + 1]]
  687.         set psub [join [lrange $path 0 $i] :]
  688.         if {[lsearch -exact $htmlCaseFolders $psub] < 0} {
  689.             lappend htmlCaseFolders $psub
  690.             append htmlCaseFiles " " [glob -nocomplain "$psub:*"]
  691.         }
  692.         if {[lsearch -exact $htmlCaseFiles "$psub:$l"] < 0} {return 0}
  693.     }
  694.     return 1
  695. }
  696.  
  697. #===============================================================================
  698. # Moving files
  699. #===============================================================================
  700.  
  701. # Moves files from one folder to another and update all links to the moved files
  702. # as well as all links in the moved files.
  703. proc htmlMoveFiles {} {
  704.     global HTMLmodeVars
  705.     
  706.     # Check that a home page is defined.
  707.     if {![htmlIsThereAHomePage]} {return}
  708.     
  709.     if {[htmlAllSaved "{All windows must be saved before you can moves files. Save?}"] == "no"} {return}
  710.  
  711.     # Get folder to move from.
  712.     if {[catch {htmlGetDir "Move from."} fromFolder]} {return}
  713.     set base [htmlBASEfromPath $fromFolder]
  714.     # Is this folder in a home page folder?
  715.     if {[lindex $base 0] == "file:///"} {
  716.         alertnote "'[file tail $fromFolder]' is not in a home page folder or an include folder."
  717.         return 
  718.     }
  719.     set fromPath [lindex $base 1]
  720.     set homepage [lindex $base 3]
  721.     set fromBase [lindex $base 0]
  722.     set isInInclFldr [lindex $base 4]
  723.     set inclFld [lindex $base 5]
  724.     
  725.     # Check that the corresponding include or home page folder exists.
  726.     if {$isInInclFldr} {
  727.         if {![file isdirectory $homepage]} {
  728.             alertnote "Could not find the corresponding home page folder for\
  729.             ${fromBase}$fromPath. Fix that and try again."
  730.             htmlHomePages "${fromBase}$fromPath"
  731.             return
  732.         }
  733.     } elseif {$inclFld != "" && ![file isdirectory $inclFld]} {
  734.         alertnote "Could not find the corresponding include folder for\
  735.         ${fromBase}$fromPath. Fix that and try again."
  736.         htmlHomePages "${fromBase}$fromPath"
  737.         return
  738.     }
  739.     
  740.     # Get files to move.
  741.     set files [glob -nocomplain "$fromFolder:*"]
  742.     foreach f $files {
  743.         if {![file isdirectory $f]} {
  744.             lappend filelist [file tail $f]
  745.         }
  746.     }
  747.     if {![info exists filelist]} {
  748.         alertnote "Empty folder."
  749.         return
  750.     }
  751.     
  752.     if {[catch {listpick -p "Select files to move." -l $filelist} movefiles] || \
  753.     ![string length $movefiles]} {return}
  754.     
  755.     # Get folder to move to.
  756.     if {[catch {htmlGetDir "Move to."} toFolder]} {return}
  757.     if {$fromFolder == $toFolder} {
  758.         alertnote "This is the same folder as you moved from."
  759.         return
  760.     }
  761.     # Is this folder in the same home page folder?
  762.     if {!$isInInclFldr && ![string match "${homepage}:*" "$toFolder:"] ||
  763.     $isInInclFldr && ![string match "${inclFld}:*" "$toFolder:"]} {
  764.         set msg {"home page" "" "" "" "include"}
  765.         alertnote "'[file tail $toFolder]' is not in the same [lindex $msg $isInInclFldr] folder."
  766.         return
  767.     }
  768.         
  769.     # Move the files.
  770.     foreach f $movefiles {
  771.         if {[file exists "$toFolder:$f"]} {
  772.             if {[askyesno "Replace '$f' in folder '[file tail $toFolder]'?"] == "yes"} {
  773.                 removeFile "$toFolder:$f"
  774.             } else {
  775.                 continue
  776.             }
  777.         }
  778.         set reo 0
  779.         foreach w [winNames -f] {
  780.             if {[stripNameCount $w] == "$fromFolder:$f"} {
  781.                 alertnote "'[file tail $w]' must be closed before it can be moved. It will be reopened again."
  782.                 bringToFront $w
  783.                 killWindow
  784.                 set reo 1
  785.             }
  786.         }
  787.         if {[catch {moveFile "$fromFolder:$f" "$toFolder:$f"}] && ![file exists "$toFolder:$f"]} {
  788.             alertnote "Could not move $f. An error occurred."
  789.             if {$reo} {lappend reOpen "$fromFolder:$f"}
  790.         } else {
  791.             lappend movedFiles "$fromFolder:$f"
  792.             lappend movedFiles2 "$toFolder:$f"
  793.             if {$reo} {lappend reOpen "$toFolder:$f"}
  794.         }
  795.     }
  796.     
  797.     if {[info exists movedFiles] && [lindex [dialog -w 400 -h 70 -t "Files have been moved. Update links?" \
  798.       10 10 290 30 -b Update 20 40 85 60 -b Cancel 105 40 170 60] 0]} {
  799.         if {$isInInclFldr} {
  800.             set x [htmlUpdateAfterMove3 $movedFiles $movedFiles2 $homepage $inclFld]
  801.             set num [lindex $x 0]
  802.             set changed [lindex $x 1]
  803.         } else {
  804.             set x [htmlUpdateAfterMove $movedFiles $movedFiles2 $fromBase $fromPath $homepage $homepage]
  805.             set num [lindex $x 0]
  806.             set changed [lindex $x 1]
  807.             incr num [htmlUpdateAfterMove2 $movedFiles $movedFiles2 $fromBase $fromPath $homepage]
  808.         }
  809.     }
  810.     
  811.     catch {message "$num files has been modified including the ones moved."}
  812.  
  813.     if {[info exists reOpen] && [askyesno "Reopen previously closed windows?"] == "yes"} {
  814.         foreach r $reOpen {
  815.             edit $r
  816.         }
  817.     }
  818.     
  819.     if {[llength $changed] && [askyesno "Update affected windows?"] == "yes"} {
  820.         foreach r $changed {
  821.             bringToFront $r
  822.             revert
  823.         }
  824.     }
  825. }
  826.  
  827. # Updates links to moved files.
  828. proc htmlUpdateAfterMove {movedFiles movedFiles2 fromBase fromPath homepage isinfld} {
  829.     global htmlURLAttr
  830.     
  831.     set allfiles [htmlAllHTMLfiles $isinfld 1 $movedFiles2]
  832.     
  833.     # Build regular expressions with URL attrs.
  834.     set exp "([join $htmlURLAttr |])"
  835.  
  836.     set exprr "${exp}(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  837.     set exprr2 {(url)\((\"?[^\"\)]+\"?)\)}
  838.  
  839.     # Update links to the moved files.
  840.     set toModify [htmlScanFiles $allfiles $fromBase $fromPath $homepage $isinfld 0 0 $movedFiles]
  841.     set fidr [lindex $toModify 0]
  842.     seek $fidr 0
  843.     set num 0
  844.     set changed ""
  845.     set thisfile ""
  846.     while {![eof $fidr]} {
  847.         gets $fidr modify
  848.         if {$modify == ""} {continue}
  849.  
  850.         set fil [lindex $modify 0]
  851.         if {$thisfile != $fil} {
  852.             if {[string length $thisfile]} {
  853.                 if {[catch {open $thisfile w} fid]} {
  854.                     alertnote "Could not update [file tail $thisfile]. An error occurred."
  855.                 } else {
  856.                     puts -nonewline $fid [join $filecont "\r"]
  857.                     close $fid
  858.                 }
  859.             }
  860.             message "Modifying [file tail $fil]…"
  861.             foreach w [winNames -f] {
  862.                 if {[stripNameCount $w] == "$fil"} {
  863.                     lappend changed $w
  864.                 }
  865.             }
  866.             set fid [open $fil r]
  867.             incr num
  868.             set filec [read $fid]
  869.             close $fid
  870.             if {[regexp {\n} $filec]} {
  871.                 set newln "\n"
  872.             } else {
  873.                 set newln "\r"
  874.             }
  875.             set filec [split $filec $newln]
  876.             set filecont ""
  877.             foreach fc $filec {
  878.                 lappend filecont [string trimleft $fc "\r"]
  879.             }
  880.         }
  881.         set thisfile $fil
  882.         set linenum [expr [lindex $modify 1] - 1]
  883.         set line [lindex $filecont $linenum]
  884.         set path [lindex $movedFiles2 [lsearch -exact $movedFiles [lindex $modify 5]]]
  885.         set lnk [htmlBASEfromPath $path]
  886.         if {[lindex $modify 2] == [lindex $lnk 0]} {
  887.             set linkTo [htmlRelativePath "[lindex $modify 3][lindex $modify 4]" "[lindex $lnk 1][lindex $lnk 2]"]
  888.         } else {
  889.             set linkTo [join [lrange $lnk 0 2] ""]
  890.         }
  891.         set linkTo [htmlURLescape2 $linkTo]
  892.         regsub -all {[\(\)]} [lindex $modify 6] {\\\0} tomod
  893.         regexp -indices $tomod $line href
  894.         if {![regexp -nocase -indices $exprr [string range $line [lindex $href 0] [lindex $href 1]] a b url]} {
  895.             regexp -nocase -indices $exprr2 [string range $line [lindex $href 0] [lindex $href 1]] a b url
  896.         }
  897.         set anchor ""
  898.         regexp {[^#]*(#[^\"]*)} $tomod a anchor
  899.         set line "[string range $line 0 [expr [lindex $href 0] + [lindex $url 0] - 1]]\"$linkTo$anchor\"[string range $line [expr [lindex $href 0] + [lindex $url 1] + 1] end]"
  900.         set filecont [lreplace $filecont $linenum $linenum $line]
  901.     }
  902.     if {$thisfile != ""} {
  903.         if {[catch {open $thisfile w} fid]} {
  904.             alertnote "Could not update [file tail $thisfile]. An error occurred."
  905.         } else {
  906.             puts -nonewline $fid [join $filecont "\r"]
  907.             close $fid
  908.         }
  909.     }
  910.     close $fidr
  911.     catch {removeFile [lindex $toModify 1]}
  912.     return [list $num $changed]
  913. }
  914.  
  915. # Updates links in moved files.
  916. proc htmlUpdateAfterMove2 {movedFiles movedFiles2 fromBase fromPath homepage} {
  917.     global htmlURLAttr
  918.     
  919.     set expBase "<(base\[ \\t\\n\\r\]+)\[^>\]*>"
  920.     set expBase2 "(href=)\"?(\[^ \\t\\n\\r\">\]+)\"?"
  921.  
  922.     # Build regular expressions with URL attrs.
  923.     set exp "([join $htmlURLAttr |])"
  924.     
  925.     set exprr1 "<!--|\[ \\t\\n\\r\]+$exp\"?(\[^ \\t\\n\\r\">\]+)\"?"
  926.     set exprr2 {/\*|[ \t\n\r]+(url)\(\"?([^\"\)]+)\"?\)}
  927.     set commStart1 "<!--"
  928.     set commEnd1 "-->"
  929.     set commStart2 {/*}
  930.     set commEnd2 {\*/}
  931.  
  932.     set num 0
  933.     foreach f $movedFiles2 {
  934.         getFileInfo $f finfo
  935.         if {$finfo(type) != "TEXT"} {continue}
  936.         message "Modifying [file tail $f]…"
  937.         set created $finfo(created)
  938.         set fid [open $f r]
  939.         set filecont [read $fid 16384]
  940.         set limit [expr [eof $fid] ? 0 : 300]
  941.         set temp [htmlOpenAfile]
  942.         set tempf [lindex $temp 1]
  943.         set tempfid [lindex $temp 0]
  944.         set oldfile [lindex $movedFiles [lsearch -exact $movedFiles2 $f]]
  945.         set base $fromBase
  946.         set path $fromPath
  947.         set hpPath $homepage
  948.         set epath [string range $oldfile [expr [string length $homepage] + 1] end]
  949.         regsub -all {:} $epath {/} epath
  950.         # Replace newline chars in IBM files.
  951.         regsub -all "\n\r" $filecont "\r" filecont
  952.         # If BASE is used, only modify links to moved files.
  953.         set hasBase 0
  954.         if {[regexp -nocase -indices $expBase $filecont this]} {
  955.             set preBase [string range $filecont 0 [lindex $this 0]]
  956.             set comm 0
  957.             while {[regexp -indices {<!--} $preBase bCom]} {
  958.                 set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  959.                 set comm 1
  960.                 if {[regexp -indices -- {-->} $preBase bCom]} {
  961.                     set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  962.                     set comm 0
  963.                 } else {
  964.                     break
  965.                 }
  966.             }
  967.             if {!$comm && [regexp -nocase $expBase2 [string range $filecont [lindex $this 0] [lindex $this 1]] d1 d2 url1]} {
  968.                 set hasBase 1
  969.             }
  970.         }
  971.         if {$hasBase && ![catch {htmlBASEpieces $url1} basestr]} {
  972.             set base [lindex $basestr 0]
  973.             set path [lindex $basestr 1]
  974.             set epath [lindex $basestr 2]
  975.             set hpPath ""
  976.         }
  977.         incr num
  978.         for {set i1 1} {$i1 < 3} {incr i1} {
  979.             if {$i1 == 2} {
  980.                 close $fid
  981.                 seek $tempfid 0
  982.                 set fid $tempfid
  983.                 set filecont [read $fid 16384]
  984.                 set limit [expr [eof $fid] ? 0 : 300]
  985.                 set temp [htmlOpenAfile]
  986.                 set tempfid [lindex $temp 0]
  987.             }
  988.             set commStart [set commStart$i1]
  989.             set commEnd [set commEnd$i1]
  990.             set exprr [set exprr$i1]
  991.             set comment 0
  992.             while {1} {
  993.                 while {$comment || ([regexp -nocase -indices $exprr $filecont href b url] &&
  994.                 [expr [string length $filecont] - [lindex $href 0]] > $limit)} {
  995.                     # Comment?
  996.                     if {$comment || [string range $filecont [lindex $href 0] [lindex $href 1]] == $commStart} {
  997.                         if {$comment} {
  998.                             set href {0 0}
  999.                             set subcont $filecont
  1000.                         } else {
  1001.                             set subcont [string range $filecont [expr [lindex $href 1] + 1] end]
  1002.                         }
  1003.                         if {[regexp -indices -- $commEnd $subcont cend] &&
  1004.                         [expr [string length $subcont] - [lindex $cend 0]] > $limit} {
  1005.                             puts -nonewline $tempfid [string range $filecont 0 [expr [lindex $href 1] + [lindex $cend 1] - 1]]
  1006.                             set filecont [string range $filecont [expr [lindex $href 1] + [lindex $cend 1]] end]
  1007.                             set comment 0
  1008.                             continue
  1009.                         } else {
  1010.                             set comment 1
  1011.                             break
  1012.                         }
  1013.                     }
  1014.                     
  1015.                     set urltxt [string range $filecont [lindex $url 0] [lindex $url 1]]
  1016.                     # No need to update links beginning with a /
  1017.                     if {[string index $urltxt 0] == "/"} {
  1018.                         puts -nonewline $tempfid [string range $filecont 0 [lindex $url 1]]
  1019.                         set filecont [string range $filecont [expr [lindex $url 1] + 1] end]
  1020.                         continue
  1021.                     }    
  1022.                     set anchor ""
  1023.                     regexp {[^#]*(#[^\"]*)} $urltxt a anchor
  1024.                     set urltxt [htmlURLunEscape $urltxt]
  1025.                     if {[catch {lindex [htmlPathToFile $base $path $epath $hpPath $urltxt] 0} topath]} {set topath ""}
  1026.                     # Ignore anchors if not moved and BASE.
  1027.                     # Is the link pointing to a previously moved file?
  1028.                     if {[set mvind [lsearch -exact $movedFiles $topath]] >= 0} {
  1029.                         set topath [lindex $movedFiles2 $mvind]
  1030.                         if {!$hasBase && [string index $urltxt 0] == "#"} {set topath ""}
  1031.                     } elseif {[string index $urltxt 0] == "#"} {
  1032.                         set topath ""
  1033.                     }
  1034.                         
  1035.                     if {$hasBase && [regexp -nocase -indices $expBase $filecont thisLine] \
  1036.                     && [regexp -nocase $expBase2 [string range $filecont [lindex $thisLine 0] [lindex $thisLine 1]]]\
  1037.                     && [lindex $thisLine 0] < [lindex $url 0] && [lindex $thisLine 1] > [lindex $url 1]} {
  1038.                         set topath ""
  1039.                     }
  1040.                     if {[string length $topath]} {
  1041.                         set lnk [htmlBASEfromPath $topath]
  1042.                         if {!$hasBase} {
  1043.                             set lnk1 [htmlBASEfromPath $f]
  1044.                             set path2 [lindex $lnk1 1]
  1045.                             set epath2 [lindex $lnk1 2]
  1046.                         } else {
  1047.                             set path2 $path
  1048.                             set epath2 $epath
  1049.                         }
  1050.                         if {$base == [lindex $lnk 0]} {
  1051.                             set newurl [htmlRelativePath "$path2$epath2" "[lindex $lnk 1][lindex $lnk 2]"]
  1052.                         } else {
  1053.                             set newurl [join [lrange $lnk 0 2] ""]
  1054.                         }
  1055.                         append newurl $anchor
  1056.                     } elseif {!$hasBase && ($urltxt == ".." || [string range $urltxt 0 2] == "../")} {
  1057.                         # Special case with relative links outside home page.
  1058.                         set urlspl [split $urltxt /]
  1059.                         set old [split $oldfile :]
  1060.                         set new [split $f :]
  1061.                         if {[llength $new] > [llength $old]} {
  1062.                             set newurl ""
  1063.                             for {set i 0} {$i < [expr [llength $new] - [llength $old]]} {incr i} {
  1064.                                 append newurl "../"
  1065.                             }
  1066.                             append newurl $urltxt
  1067.                         } else {
  1068.                             set ok 1
  1069.                             for {set i 0} {$i < [expr [llength $old] - [llength $new]]} {incr i} {
  1070.                                 if {[lindex $urlspl $i] != ".."} {set ok 0}
  1071.                             }
  1072.                             if {$ok} {
  1073.                                 set newurl "[join [lrange $urlspl [expr [llength $old] - [llength $new]] end] /]$anchor"
  1074.                             } else {
  1075.                                 set newurl $urltxt
  1076.                             }
  1077.                         }
  1078.                     } else {
  1079.                         set newurl $urltxt
  1080.                     }
  1081.                     puts -nonewline $tempfid [string range $filecont 0 [expr [lindex $url 0] - 1]]
  1082.                     puts -nonewline $tempfid [htmlURLescape2 $newurl]
  1083.                     set filecont [string range $filecont [expr [lindex $url 1] + 1] end]
  1084.                 }
  1085.                 if {![eof $fid]} {
  1086.                     puts -nonewline $tempfid [string range $filecont 0 [expr [string length $filecont] - 301]]
  1087.                     set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  1088.                     set limit [expr [eof $fid] ? 0 : 300] 
  1089.                 } else {
  1090.                     break
  1091.                 }
  1092.             }
  1093.             puts -nonewline $tempfid $filecont
  1094.         }
  1095.         close $fid
  1096.         close $tempfid
  1097.         if {[catch {removeFile $f}] && [file exists $f]} {
  1098.             alertnote "Could not update [file tail $f]. An error occurred."
  1099.         } else {
  1100.             catch {copyFile [lindex $temp 1] $f; setFileInfo $f created $created}
  1101.         }
  1102.         catch {removeFile [lindex $temp 1]}
  1103.         catch {removeFile $tempf}
  1104.     }
  1105.     return $num
  1106. }
  1107.  
  1108. # Updates include links to moved files in include folder.
  1109. proc htmlUpdateAfterMove3 {movedFiles movedFiles2 homepage inclFldr} {
  1110.     set num 0
  1111.     set changed ""
  1112.     set allFiles [htmlAllHTMLfiles $homepage]
  1113.     set fid0 [open $allFiles]
  1114.  
  1115.     while {![eof $fid0]} {
  1116.         gets $fid0 fil
  1117.         if {$fil == "" || [catch {open $fil} fid]} {continue}
  1118.         set filecont [read $fid 16384]
  1119.         set limit [expr [eof $fid] ? 0 : 300]
  1120.         message "Looking at [file tail $fil]…"
  1121.         getFileInfo $fil finfo
  1122.         set created $finfo(created)
  1123.         regsub -all "\n\r" $filecont "\r" filecont
  1124.         set temp [htmlOpenAfile]
  1125.         set tmpfid [lindex $temp 0]
  1126.         set ismod 0
  1127.         while {1} {
  1128.             while {[regexp -nocase -indices {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>} $filecont res] &&
  1129.             [expr [string length $filecont] - [lindex $res 0]] > $limit} {
  1130.                 set link [string range $filecont [lindex $res 0] [lindex $res 1]]
  1131.                 if {[regexp -nocase -indices {FILE=\"([^\"]+)\"} $link dum res1] &&
  1132.                 [set ind [lsearch -exact $movedFiles [htmlResolveInclPath [htmlUnQuote \
  1133.                     [string range $link [lindex $res1 0] [lindex $res1 1]]] $inclFldr:]]] >= 0} {
  1134.                     puts -nonewline $tmpfid [string range $filecont 0 [expr [lindex $res 0] + [lindex $res1 0] - 1]]
  1135.                     puts -nonewline $tmpfid [htmlQuote [htmlConvertInclPath [lindex $movedFiles2 $ind] $inclFldr:]]
  1136.                     puts -nonewline $tmpfid [string range $filecont [expr [lindex $res 0] + [lindex $res1 1] + 1] [lindex $res 1]]
  1137.                     set ismod 1
  1138.                     message "Modifying [file tail $fil]…"
  1139.                 } else {
  1140.                     puts -nonewline $tmpfid [string range $filecont 0 [lindex $res 1]]
  1141.                 }
  1142.                 set filecont [string range $filecont [expr [lindex $res 1] + 1] end]
  1143.             }
  1144.             if {![eof $fid]} {
  1145.                 puts -nonewline $tmpfid [string range $filecont 0 [expr [string length $filecont] - 301]]
  1146.                 set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  1147.                 set limit [expr [eof $fid] ? 0 : 300]
  1148.             } else {
  1149.                 break
  1150.             }
  1151.         }
  1152.         puts -nonewline $tmpfid $filecont
  1153.         close $tmpfid
  1154.         close $fid
  1155.         if {$ismod} {
  1156.             if {[catch {removeFile $fil}] && [file exists $fil]} {
  1157.                 alertnote "Could not update [file tail $fil]. An error occurred."
  1158.             } else {
  1159.                 catch {copyFile [lindex $temp 1] $fil; setFileInfo $fil created $created}
  1160.             }
  1161.             incr num
  1162.             foreach w [winNames -f] {
  1163.                 if {[stripNameCount $w] == "$fil"} {
  1164.                     lappend changed $w
  1165.                 }
  1166.             }
  1167.         }
  1168.         catch {removeFile [lindex $temp 1]}
  1169.     }
  1170.     close $fid0
  1171.     catch {removeFile $allFiles}
  1172.     return [list $num $changed]
  1173. }
  1174.  
  1175.  
  1176. #===============================================================================
  1177. # Includes
  1178. #===============================================================================
  1179. proc htmlConvertInclPath {fil path} {
  1180.     if {$path != "" && [string match "${path}*" $fil]} {
  1181.         return ":INCLUDE:[string range $fil [string length $path] end]"
  1182.     }
  1183.     return $fil
  1184. }
  1185.  
  1186. proc htmlPasteIncludeTags {} {
  1187.     global htmlHomePageWinURL
  1188.     if {![info exists htmlHomePageWinURL]} {message "No file to paste."; return}
  1189.     htmlInsertIncludeTags $htmlHomePageWinURL
  1190. }
  1191.  
  1192. # Inserts new include tags at the current position.
  1193. proc htmlInsertIncludeTags {{fil ""}} {
  1194.     global HTMLmodeVars
  1195.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  1196.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  1197.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $sexpr [getPos]} res] &&
  1198.         ([catch {search -s -f 0 -r 1 -i 1 -m 0 $eexpr [getPos]} res1]
  1199.         || [lindex $res 0] > [lindex $res1 0])} {
  1200.         alertnote "Current position is inside an include container."
  1201.         return
  1202.     }
  1203.     if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [getPos]} res] &&
  1204.         ([catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [getPos]} res1]
  1205.         || [lindex $res 0] < [lindex $res1 0])} {
  1206.         alertnote "Current position is inside an include container."
  1207.         return
  1208.     }
  1209.     if {$fil == "" && [catch {getfile "Select file to include."} fil]} {return}
  1210.     if {![htmlIsTextFile $fil alertnote]} {return}
  1211.     set fil1 [htmlQuote [htmlConvertInclPath $fil \
  1212.         [htmlWhichInclFolder [stripNameCount [lindex [winNames -f] 0]]]]]
  1213.     set text "<!-- [htmlSetCase {#INCLUDE FILE=}]\"$fil1\" -->\r\r"
  1214.     if {$HTMLmodeVars(includeOnlyTags)} {append text "<B>The file [file tail $fil1] will be inserted here when the window is updated.</B>"}
  1215.     append text "\r\r" "<!-- [htmlSetCase /#INCLUDE] -->"
  1216.     insertText [htmlOpenCR "" 1] $text "\r\r"
  1217.     if {!$HTMLmodeVars(includeOnlyTags)} {htmlUpdateWindow $fil1}
  1218. }
  1219.  
  1220. # Updates the text between all include tags.
  1221. proc htmlUpdateWindow {{fil ""}} {htmlUpdateInclude Window $fil}
  1222. proc htmlUpdateHomePage {} {htmlUpdateInclude Home}
  1223. proc htmlUpdateFolder {} {htmlUpdateInclude Folder}
  1224. proc htmlUpdateFile {} {htmlUpdateInclude File}
  1225.  
  1226. proc htmlUpdateInclude {where {onlyThis ""}} {
  1227.     global HTMLmodeVars PREFS htmlUpdateErr htmlUpdateList htmlUpdateBase htmlUpdatePath htmlUpdateHome
  1228.     global tileLeft tileTop tileWidth errorHeight
  1229.     # Clean up after previous update
  1230.     if {[file exists $PREFS:HTMLtmp:incl]} {catch {rm -r $PREFS:HTMLtmp:incl}}
  1231.     if {[file exists $PREFS:HTMLtmp:xincl]} {catch {rm -r $PREFS:HTMLtmp:xincl}}
  1232.     
  1233.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  1234.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  1235.     set expBase "<(base\[ \\t\\n\\r\]+)\[^>\]*>"
  1236.     set expBase2 "(href=)\"?(\[^ \\t\\n\\r\">\]+)\"?"
  1237.     set htmlUpdateErr ""
  1238.     if {$where == "Window"} {
  1239.         set wname [stripNameCount [lindex [winNames -f] 0]]
  1240.         set htmlUpdateList $wname
  1241.         set inclFldr [htmlWhichInclFolder $wname]
  1242.         set home [htmlWhichHomeFolder $wname]
  1243.         if {$home != ""} {
  1244.             set htmlUpdateBase [lindex $home 1]
  1245.             set htmlUpdatePath [lindex $home 2]
  1246.             set htmlUpdateHome [list [lindex $home 1] [lindex $home 2]]
  1247.         } else {
  1248.             set htmlUpdateHome [list [set htmlUpdateBase "file:///"] ""]
  1249.             regsub -all : [file dirname $wname] / htmlUpdatePath
  1250.         }
  1251.         regsub -all : [string range $wname [expr [string length [lindex $home 0]] + 1] end] / tp
  1252.         append htmlUpdatePath [string range $tp 0 [string last / $tp]]
  1253.         set hasBase 0
  1254.         if {![catch {search -s -f 1 -i 1 -m 0 -r 1 $expBase 0} this]} {
  1255.             set preBase [lindex $this 0]
  1256.             set comm 0
  1257.             set spos 0
  1258.             while {![catch {search -s -f 1 -i 1 -m 0 -l $preBase {<!--} $spos} bCom]} {
  1259.                 set spos [lindex $bCom 1]
  1260.                 set comm 1
  1261.                 if {![catch {search -s -f 1 -i 1 -m 0 -l $preBase -- {-->} $spos} bCom]} {
  1262.                     set spos [lindex $bCom 1]
  1263.                     set comm 0
  1264.                 } else {
  1265.                     break
  1266.                 }
  1267.             }
  1268.             if {!$comm && [regexp -nocase $expBase2 [getText [lindex $this 0] [lindex $this 1]] d1 d2 url1]} {
  1269.                 set hasBase 1
  1270.             }
  1271.         }
  1272.         if {$hasBase && ![catch {htmlBASEpieces $url1} basestr]} {
  1273.             set htmlUpdateBase [lindex $basestr 0]
  1274.             set tp [lindex $basestr 2]
  1275.             set htmlUpdatePath "[lindex $basestr 1][string range $tp 0 [string last / $tp]]"
  1276.         }
  1277.         set pos 0
  1278.         while {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr $pos} res]} {
  1279.             set lnum [lindex [posToRowCol [lindex $res 0]] 0]
  1280.             set ln [expr 5 - [string length $lnum]]
  1281.             if {[catch {search -s -f 1 -r 1 -i 1 -m 0 $eexpr [lindex $res 1]} res1]} {
  1282.                 append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]Opening include tag without a matching end tag."\
  1283.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  1284.                 break
  1285.             }
  1286.             if {![catch {search -s -f 1 -r 1 -i 1 -m 0 $sexpr [lindex $res 1]} res2]
  1287.             && [lindex $res2 0] < [lindex $res1 0]} {
  1288.                 append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]Nested include tags."\
  1289.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"
  1290.                 set pos [lindex $res1 1]
  1291.                 continue
  1292.             }    
  1293.             if {[catch {htmlReadInclude [eval getText $res] 1 $inclFldr 0 $onlyThis} text]} {
  1294.                 if {$text != "Not this file"} {append htmlUpdateErr "Line $lnum:[format "%$ln\s" ""]$text"\
  1295.                         "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$wname\r"}
  1296.                 set pos [lindex $res1 1]
  1297.             } else {
  1298.                 replaceText [lindex $res 1] [lindex $res1 0] "\r\r" $text "\r\r"
  1299.                 set pos [expr [lindex $res 1] + [string length $text] + 4]
  1300.             }
  1301.         }
  1302.     } else {
  1303.         if {[htmlAllSaved "-c {Save all open windows before updating?}"] == "cancel"} {return}
  1304.         if {$where == "File"} {
  1305.             if {[catch {getfile "Select file to update."} files]} {return}
  1306.             if {![htmlIsTextFile $files alertnote]} {return}
  1307.             set inclFldr [htmlWhichInclFolder $files]
  1308.             set home [htmlWhichHomeFolder $files]
  1309.             set folder [file dirname $files]
  1310.             set filelist [htmlOpenAfile]
  1311.             puts [lindex $filelist 0] $files
  1312.             close [lindex $filelist 0]
  1313.             set files [lindex $filelist 1]
  1314.         } elseif {$where == "Folder"} {
  1315.             if {[catch {htmlGetDir "Update folder:"} folder]} {return}
  1316.             set inclFldr [htmlWhichInclFolder "${folder}:"]
  1317.             set home [htmlWhichHomeFolder "${folder}:"]
  1318.             set subFolders [expr ![string compare yes [askyesno "Update files in subfolders?"]]]
  1319.             if {$subFolders} {
  1320.                 set files [htmlAllHTMLfiles $folder]
  1321.             } else {
  1322.                 set files [htmlGetHTMLfiles $folder]
  1323.             }
  1324.         } else {
  1325.             if {![htmlIsThereAHomePage] ||
  1326.             [catch {htmlWhichHomePage "update"} home]} {return}
  1327.             set folder [lindex $home 0]
  1328.             set inclFldr [htmlWhichInclFolder "${folder}:"]
  1329.             set files [htmlAllHTMLfiles $folder]
  1330.         }
  1331.         set fid0 [open $files]
  1332.         while {![eof $fid0]} {
  1333.             gets $fid0 f
  1334.             if {$f == "" || [catch {open $f} fid1]} {continue}
  1335.             set filecont [read $fid1 16384]
  1336.             close $fid1
  1337.             if {$home != ""} {
  1338.                 set htmlUpdateBase [lindex $home 1]
  1339.                 set htmlUpdatePath [lindex $home 2]
  1340.                 set htmlUpdateHome [list [lindex $home 1] [lindex $home 2]]
  1341.             } else {
  1342.                 set htmlUpdateHome [list [set htmlUpdateBase "file:///"] ""]
  1343.                 regsub -all : [file dirname $f] / htmlUpdatePath
  1344.             }
  1345.             regsub -all : [string range $f [expr [string length [lindex $home 0]] + 1] end] / tp
  1346.             append htmlUpdatePath [string range $tp 0 [string last / $tp]]
  1347.             set hasBase 0
  1348.             if {[regexp -nocase -indices $expBase $filecont this]} {
  1349.                 set preBase [string range $filecont 0 [lindex $this 0]]
  1350.                 set comm 0
  1351.                 while {[regexp -indices {<!--} $preBase bCom]} {
  1352.                     set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  1353.                     set comm 1
  1354.                     if {[regexp -indices -- {-->} $preBase bCom]} {
  1355.                         set preBase [string range $preBase [expr [lindex $bCom 1] - 1] end]
  1356.                         set comm 0
  1357.                     } else {
  1358.                         break
  1359.                     }
  1360.                 }
  1361.                 if {!$comm && [regexp -nocase $expBase2 [string range $filecont [lindex $this 0] [lindex $this 1]] d1 d2 url1]} {
  1362.                     set hasBase 1
  1363.                 }
  1364.             }
  1365.             if {$hasBase && ![catch {htmlBASEpieces $url1} basestr]} {
  1366.                 set htmlUpdateBase [lindex $basestr 0]
  1367.                 set tp [lindex $basestr 2]
  1368.                 set htmlUpdatePath "[lindex $basestr 1][string range $tp 0 [string last / $tp]]"
  1369.             }
  1370.             set htmlUpdateList $f
  1371.             if {[htmlUpdateOneFile $f $f $folder $inclFldr 0]} {lappend modified $f}
  1372.         }
  1373.         close $fid0
  1374.         catch {removeFile $files}
  1375.     }
  1376.     if {$htmlUpdateErr != ""} {
  1377.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  1378.         set name [lindex [winNames] 0]
  1379.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  1380.         insertText $htmlUpdateErr
  1381.         htmlSetWin
  1382.     } else {
  1383.         message "$where updated successfully."
  1384.     }
  1385.     if {[info exists modified]} {
  1386.         foreach w [winNames -f] {
  1387.             if {[lsearch -exact $modified [stripNameCount $w]] >= 0} {
  1388.                 if {[askyesno "Update affected windows?"] == "yes"} {
  1389.                     foreach ww [winNames -f] {
  1390.                         if {[lsearch -exact $modified [stripNameCount $ww]] >= 0} {
  1391.                             bringToFront $ww
  1392.                             revert
  1393.                         }
  1394.                     }
  1395.                 }
  1396.                 if {$htmlUpdateErr != ""} {bringToFront $name}
  1397.                 break
  1398.             }
  1399.         }
  1400.     }
  1401.     # Clean up
  1402.     if {[file exists $PREFS:HTMLtmp:incl]} {rm -r $PREFS:HTMLtmp:incl}
  1403.     if {[file exists $PREFS:HTMLtmp:xincl]} {rm -r $PREFS:HTMLtmp:xincl}
  1404.     unset htmlUpdateErr htmlUpdateList htmlUpdateBase htmlUpdatePath
  1405. }
  1406.  
  1407. proc htmlUpdateOneFile {f f1 folder inclFldr depth} {
  1408.     global htmlUpdateErr htmlUpdateBase htmlUpdatePath htmlUpdateHome htmlURLAttr
  1409.     if {[catch {open $f1} fid]} {return 0}
  1410.     message "Updating [file tail $f1]…"
  1411.     set sexpr {<!--[ \t\r\n]+#INCLUDE[ \t\r\n]+[^>]+>}
  1412.     set eexpr {<!--[ \t\r\n]+/#INCLUDE[ \t\r\n]+[^>]+>}
  1413.     set exp "([join $htmlURLAttr |])"
  1414.     
  1415.     set exprr1 "<!--|\[ \\t\\n\\r\]+$exp\"?(\[^ \\t\\n\\r\">\]+)\"?"
  1416.     set exprr2 {/\*|[ \t\n\r]+(url)\(\"?([^\"\)]+)\"?\)}
  1417.     set commStart1 "<!--"
  1418.     set commEnd1 "-->"
  1419.     set commStart2 {/*}
  1420.     set commEnd2 {\*/}
  1421.     getFileInfo $f1 finfo
  1422.     if {!$depth} {set created $finfo(created)}
  1423.     set filecont [read $fid 16384]
  1424.     set limit [expr [eof $fid] ? 0 : 300]
  1425.     regsub -all "\n\r" $filecont "\r" filecont
  1426.     if {[regexp {\n} $filecont]} {
  1427.         set newln "\n"
  1428.     } else {
  1429.         set newln "\r"
  1430.     }
  1431.     set linenum 1
  1432.     set ismod 0
  1433.     set errf [string range $f [expr [string length $folder] + 1] end]
  1434.     set temp [htmlOpenAfile]
  1435.     set tmpfid [lindex $temp 0]
  1436.     if {$depth} {puts $tmpfid "$htmlUpdateBase$htmlUpdatePath"}
  1437.     set opening 0
  1438.     set l [expr 20 - [string length [file tail $f]]]
  1439.     while {1} {
  1440.         while {$opening || ([regexp -nocase -indices $sexpr $filecont res] && 
  1441.         [expr [string length $filecont] - [lindex $res 0]] > $limit)} {
  1442.             if {!$opening} {
  1443.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res 0]] {} dummy]
  1444.                 set ln [expr 5 - [string length $linenum]]
  1445.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res 1]]
  1446.                 set readName [string range $filecont [lindex $res 0] [lindex $res 1]]
  1447.                 set filecont [string range $filecont [expr [lindex $res 1] + 1] end]
  1448.             }
  1449.             if {![regexp -nocase -indices $eexpr $filecont res1] ||
  1450.             [expr [string length $filecont] - [lindex $res1 0]] <= $limit} {
  1451.                 if {[eof $fid]} {
  1452.                     append htmlUpdateErr [htmlBrwsErr $errf $l $linenum $ln "Opening include tag without a matching end tag." $f]
  1453.                 } else {
  1454.                     set opening 1
  1455.                 }
  1456.                 break
  1457.             }
  1458.             set toReplace [string trim [string range $filecont 0 [expr [lindex $res1 0] - 1]]]
  1459.             set opening 0
  1460.             if {[regexp -nocase -indices $sexpr $filecont res2]
  1461.             && [lindex $res2 0] < [lindex $res1 0]} {
  1462.                 append htmlUpdateErr [htmlBrwsErr $errf $l $linenum $ln "Nested include tags." $f]
  1463.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res1 1]]
  1464.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  1465.                 set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  1466.                 continue
  1467.             }
  1468.             if {[catch {htmlReadInclude $readName 0 $inclFldr $depth} text]} {
  1469.                 append htmlUpdateErr [htmlBrwsErr $errf $l $linenum $ln $text $f]
  1470.                 puts -nonewline $tmpfid [string range $filecont 0 [lindex $res1 1]]                    
  1471.                 incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  1472.                 set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  1473.                 continue
  1474.             }
  1475.             if {[string trim $text] != $toReplace} {
  1476.                 set ismod 1
  1477.             }
  1478.             puts -nonewline $tmpfid "$newln$newln$text$newln$newln"
  1479.             puts -nonewline $tmpfid [string range $filecont [lindex $res1 0] [lindex $res1 1]]
  1480.             incr linenum [regsub -all $newln [string range $filecont 0 [lindex $res1 1]] {} dummy]
  1481.             set filecont [string range $filecont [expr [lindex $res1 1] + 1] end]
  1482.         }
  1483.         if {![eof $fid]} {
  1484.             if {$opening} {
  1485.                 append filecont [read $fid 16384]
  1486.             } else {
  1487.                 puts -nonewline $tmpfid [string range $filecont 0 [expr [string length $filecont] - 301]]
  1488.                 incr linenum [regsub -all $newln [string range $filecont 0 [expr [string length $filecont] - 301]] {} dummy]
  1489.                 set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  1490.             }
  1491.             set limit [expr [eof $fid] ? 0 : 300] 
  1492.         } else {
  1493.             break
  1494.         }                    
  1495.     }
  1496.     close $fid
  1497.     if {$ismod || $depth} {puts -nonewline $tmpfid $filecont}
  1498.     close $tmpfid
  1499.     if {$ismod && !$depth} {
  1500.         set linenum 1
  1501.         set opening 0
  1502.         set done 0
  1503.         set fid [open [set temp1 [lindex $temp 1]]]
  1504.         set filecont [read $fid 16384]
  1505.         set limit [expr [eof $fid] ? 0 : 300]
  1506.         set temp [htmlOpenAfile]
  1507.         set tmpfid [lindex $temp 0]
  1508.         while {1} {
  1509.             if {$opening || ([regexp -nocase -indices {<!--[ \t\r\n]+#LASTMODIFIED[ \t\r\n]+[^>]+>} $filecont res] &&
  1510.             [expr [string length $filecont] - [lindex $res 0]] > $limit)} {
  1511.                 if {!$opening} {
  1512.                     incr linenum [regsub -all "\n" [string range $filecont 0 [lindex $res 0]] {} dummy]
  1513.                     set ln [expr 5 - [string length $linenum]]
  1514.                     puts -nonewline $tmpfid [string range $filecont 0 [lindex $res 1]]
  1515.                     set lastMod [string range $filecont [lindex $res 0] [lindex $res 1]]
  1516.                     set filecont [string range $filecont [expr [lindex $res 1] + 1] end]
  1517.                 }
  1518.                 if {![regexp -nocase -indices {<!--[ \t\r\n]+/#LASTMODIFIED[ \t\r\n]+[^>]+>} $filecont res1] ||
  1519.                 [expr [string length $filecont] - [lindex $res1 0]] <= $limit} {
  1520.                     if {[eof $fid]} {
  1521.                         append htmlUpdateErr [htmlBrwsErr $errf $l $linenum $ln "Opening 'last modified' tag without a matching closing tag." $f]
  1522.                     } else {
  1523.                         set opening 1
  1524.                     }
  1525.                 } else {
  1526.                     set str [htmlGetLastMod $lastMod]
  1527.                     set done 1
  1528.                     if {$str == "0"} {
  1529.                         append htmlUpdateErr [htmlBrwsErr $errf $l $linenum $ln "Invalid 'last modified' tags." $f]
  1530.                     } else {
  1531.                         puts -nonewline $tmpfid "\r$str\r[string range $filecont [lindex $res1 0] end]"
  1532.                         set filecont ""
  1533.                     }
  1534.                 }
  1535.             }
  1536.             if {![eof $fid] && !$done} {
  1537.                 if {$opening} {
  1538.                     append filecont [read $fid 16384]
  1539.                 } else {
  1540.                     puts -nonewline $tmpfid [string range $filecont 0 [expr [string length $filecont] - 301]]
  1541.                     incr linenum [regsub -all "\n" [string range $filecont 0 [expr [string length $filecont] - 301]] {} dummy]
  1542.                     set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  1543.                 }
  1544.                 set limit [expr [eof $fid] ? 0 : 300] 
  1545.             } else {
  1546.                 break
  1547.             }
  1548.         }
  1549.         puts -nonewline $tmpfid $filecont
  1550.         while {![eof $fid]} {
  1551.             puts -nonewline $tmpfid [read $fid 16384]
  1552.         }
  1553.         close $fid
  1554.         close $tmpfid
  1555.         if {[catch {removeFile $f1}] && [file exists $f1]} {
  1556.             append htmlUpdateErr "$errf[format "%$l\s" ""]; Could not write update to file. An error occurred.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  1557.         } else {
  1558.             catch {copyFile [lindex $temp 1] $f1; setFileInfo $f1 created $created}
  1559.         }
  1560.         catch {removeFile $temp1}
  1561.     } elseif {$depth} {
  1562.         set fid [open [set temp1 [lindex $temp 1]]]
  1563.         set filecont [read $fid 16384]
  1564.         set limit [expr [eof $fid] ? 0 : 300]
  1565.         set temp [htmlOpenAfile]
  1566.         set tempf [lindex $temp 1]
  1567.         set tempfid [lindex $temp 0]
  1568.         for {set i1 1} {$i1 < 3} {incr i1} {
  1569.             if {$i1 == 2} {
  1570.                 close $fid
  1571.                 seek $tempfid 0
  1572.                 set fid $tempfid
  1573.                 set filecont [read $fid 16384]
  1574.                 set limit [expr [eof $fid] ? 0 : 300]
  1575.                 set temp [htmlOpenAfile]
  1576.                 set tempfid [lindex $temp 0]
  1577.             }
  1578.             set commStart [set commStart$i1]
  1579.             set commEnd [set commEnd$i1]
  1580.             set exprr [set exprr$i1]
  1581.             set comment 0
  1582.             while {1} {
  1583.                 while {$comment || ([regexp -nocase -indices $exprr $filecont href b url] &&
  1584.                 [expr [string length $filecont] - [lindex $href 0]] > $limit)} {
  1585.                     # Comment?
  1586.                     if {$comment || [string range $filecont [lindex $href 0] [lindex $href 1]] == $commStart} {
  1587.                         if {$comment} {
  1588.                             set href {0 0}
  1589.                             set subcont $filecont
  1590.                         } else {
  1591.                             set subcont [string range $filecont [expr [lindex $href 1] + 1] end]
  1592.                         }
  1593.                         if {[regexp -indices -- $commEnd $subcont cend] &&
  1594.                         [expr [string length $subcont] - [lindex $cend 0]] > $limit} {
  1595.                             puts -nonewline $tempfid [string range $filecont 0 [expr [lindex $href 1] + [lindex $cend 1] - 1]]
  1596.                             set filecont [string range $filecont [expr [lindex $href 1] + [lindex $cend 1]] end]
  1597.                             set comment 0
  1598.                             continue
  1599.                         } else {
  1600.                             set comment 1
  1601.                             break
  1602.                         }
  1603.                     }
  1604.                     set urltxt [string range $filecont [lindex $url 0] [lindex $url 1]]
  1605.                     set url2 [htmlURLunEscape $urltxt]
  1606.                     if {[regsub -nocase ":HOMEPAGE:" $url2 [lindex $htmlUpdateHome 1] url2]} {
  1607.                         if {[lindex $htmlUpdateHome 0] == $htmlUpdateBase} {
  1608.                             set newurl [htmlRelativePath $htmlUpdatePath $url2]
  1609.                         } else {
  1610.                             set newurl "[lindex $htmlUpdateHome 0]$url2"
  1611.                         }
  1612.                         set newurl [htmlURLescape2 $newurl]
  1613.                     } else {
  1614.                         set newurl $urltxt
  1615.                     }
  1616.                     puts -nonewline $tempfid [string range $filecont 0 [expr [lindex $url 0] - 1]]
  1617.                     puts -nonewline $tempfid $newurl
  1618.                     set filecont [string range $filecont [expr [lindex $url 1] + 1] end]
  1619.                 }
  1620.                 if {![eof $fid]} {
  1621.                     puts -nonewline $tempfid [string range $filecont 0 [expr [string length $filecont] - 301]]
  1622.                     set filecont "[string range $filecont [expr [string length $filecont] - 300] end][read $fid 16384]"
  1623.                     set limit [expr [eof $fid] ? 0 : 300] 
  1624.                 } else {
  1625.                     break
  1626.                 }
  1627.             }
  1628.             puts -nonewline $tempfid $filecont
  1629.         }
  1630.         close $fid
  1631.         close $tempfid
  1632.         if {[catch {removeFile $f1}] && [file exists $f1]} {
  1633.             append htmlUpdateErr "$errf[format "%$l\s" ""]; Could not write update to file. An error occurred.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  1634.         } else {
  1635.             catch {copyFile [lindex $temp 1] $f1}
  1636.         }
  1637.         catch {removeFile $temp1}
  1638.     }
  1639.     catch {removeFile [lindex $temp 1]}
  1640.     catch {removeFile $tempf}
  1641.     return $ismod
  1642. }
  1643.  
  1644. # Read content of a file to be included.
  1645. proc htmlReadInclude {incl nr fldr depth {onlyThis ""}} {
  1646.     global PREFS htmlUpdateList htmlUpdateBase htmlUpdatePath
  1647.     set htmlUpdateList [lrange $htmlUpdateList 0 $depth]
  1648.     if {![regexp -nocase {file=\"([^\"]+)\"} $incl dum fil]} {
  1649.         error "Invalid opening include tag."
  1650.     }
  1651.     if {$onlyThis != "" && $fil != $onlyThis} {error "Not this file"}
  1652.     if {$depth == 10} {error "Too deep recursive includes."}
  1653.     if {$fldr == "" && [regexp -nocase {^:INCLUDE:} $fil]} {error ":INCLUDE: doesn't map to a folder."}
  1654.     set fil [htmlResolveInclPath [htmlUnQuote $fil] $fldr]
  1655.     if {[lsearch -exact $htmlUpdateList $fil] >= 0} {error "Infinite loop of includes."}
  1656.     if {![file exists $fil]} {
  1657.         error "File not found."
  1658.     }
  1659.     lappend htmlUpdateList $fil
  1660.     if {[string match "$fldr*" $fil]} {
  1661.         set folder [string trimright $fldr :]
  1662.         set tmpfil "HTMLtmp:incl:[string range $fil [string length $fldr] end]"
  1663.     } else {
  1664.         set folder [file dirname $fil]
  1665.         set tmpfil "HTMLtmp:xincl:$fil"
  1666.     }
  1667.     if {![file exists "$PREFS:$tmpfil"] || ![htmlUpdateSameBase $tmpfil]} {
  1668.         foreach d [split [file dirname $tmpfil] :] {
  1669.             append d1 ":$d"
  1670.             if {![file exists "$PREFS$d1"]} {mkdir "$PREFS$d1"}
  1671.         }
  1672.         if {[file exists "$PREFS:$tmpfil"]} {catch {removeFile "$PREFS:$tmpfil"}}
  1673.         catch {copyFile $fil "$PREFS:$tmpfil"}
  1674.         htmlUpdateOneFile $fil "$PREFS:$tmpfil" $folder [htmlWhichInclFolder $fil] [incr depth]
  1675.     }
  1676.     if {[catch {open "$PREFS:$tmpfil"} fid]} {
  1677.         error "Could not read file."
  1678.     }
  1679.     gets $fid
  1680.     set text [read $fid]
  1681.     close $fid
  1682.     regsub -all "\n\r" $text "\r" text
  1683.     if {$nr} {regsub -all "\n" $text "\r" text}
  1684.     # Remove include tags from inserted text
  1685.     regsub -all -nocase "<!--\[ \t\r\n\]+/?#INCLUDE\[ \t\r\n\]+\[^>\]+>" $text "" text
  1686.     return $text
  1687. }
  1688.  
  1689. proc htmlUpdateSameBase {fil} {
  1690.     global htmlUpdateBase htmlUpdatePath PREFS
  1691.     if {[catch {open $PREFS:$fil} fid]} {return 0}
  1692.     set l [gets $fid]
  1693.     close $fid
  1694.     if {$l == "$htmlUpdateBase$htmlUpdatePath"} {return 1}
  1695.     return 0
  1696. }
  1697.